home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / ptar < prev    next >
Encoding:
Text File  |  2009-10-01  |  2.9 KB  |  115 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4. #!/usr/bin/perl
  5. use strict;
  6.  
  7. use Getopt::Std;
  8. use Archive::Tar;
  9. use File::Find;
  10.  
  11. my $opts = {};
  12. getopts('dcvzthxf:I', $opts) or die usage();
  13.  
  14. ### show the help message ###
  15. die usage() if $opts->{h};
  16.  
  17. ### enable debugging (undocumented feature)
  18. local $Archive::Tar::DEBUG                  = 1 if $opts->{d};
  19.  
  20. ### enable insecure extracting.
  21. local $Archive::Tar::INSECURE_EXTRACT_MODE  = 1 if $opts->{I};
  22.  
  23. ### sanity checks ###
  24. unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
  25.     die "You need exactly one of 'x', 't' or 'c' options: " . usage();
  26. }
  27.  
  28. my $compress    = $opts->{z} ? 1 : 0;
  29. my $verbose     = $opts->{v} ? 1 : 0;
  30. my $file        = $opts->{f} ? $opts->{f} : 'default.tar';
  31. my $tar         = Archive::Tar->new();
  32.  
  33.  
  34. if( $opts->{c} ) {
  35.     my @files;
  36.     find( sub { push @files, $File::Find::name;
  37.                 print $File::Find::name.$/ if $verbose }, @ARGV );
  38.  
  39.     Archive::Tar->create_archive( $file, $compress, @files );
  40.     exit;
  41. }
  42.  
  43. my $tar = Archive::Tar->new($file, $compress);
  44.  
  45. if( $opts->{t} ) {
  46.     print map { $_->full_path . $/ } $tar->get_files;
  47.  
  48. } elsif( $opts->{x} ) {
  49.     print map { $_->full_path . $/ } $tar->get_files
  50.         if $verbose;
  51.     Archive::Tar->extract_archive($file, $compress);
  52. }
  53.  
  54.  
  55.  
  56. sub usage {
  57.     qq[
  58. Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
  59.         ptar -x [-v] [-z] [-f ARCHIVE_FILE]
  60.         ptar -t [-z] [-f ARCHIVE_FILE]
  61.         ptar -h
  62.  
  63.     ptar is a small, tar look-alike program that uses the perl module
  64.     Archive::Tar to extract, create and list tar archives.
  65.  
  66. Options:
  67.     x   Extract from ARCHIVE_FILE
  68.     c   Create ARCHIVE_FILE from FILE
  69.     t   List the contents of ARCHIVE_FILE
  70.     f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
  71.     z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
  72.     v   Print filenames as they are added or extraced from ARCHIVE_FILE
  73.     h   Prints this help message
  74.     I   Enable 'Insecure Extract Mode', which allows archives to extract
  75.         files outside the current working directory. (Not advised).
  76.  
  77. See Also:
  78.     tar(1)
  79.     Archive::Tar
  80.  
  81.     \n]
  82. }
  83.  
  84. =head1 NAME
  85.  
  86. ptar - a tar-like program written in perl
  87.  
  88. =head1 DESCRIPTION
  89.  
  90. ptar is a small, tar look-alike program that uses the perl module
  91. Archive::Tar to extract, create and list tar archives.
  92.  
  93. =head1 SYNOPSIS
  94.  
  95.     ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
  96.     ptar -x [-v] [-z] [-f ARCHIVE_FILE]
  97.     ptar -t [-z] [-f ARCHIVE_FILE]
  98.     ptar -h
  99.  
  100. =head1 OPTIONS
  101.  
  102.     x   Extract from ARCHIVE_FILE
  103.     c   Create ARCHIVE_FILE from FILE
  104.     t   List the contents of ARCHIVE_FILE
  105.     f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
  106.     z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
  107.     v   Print filenames as they are added or extraced from ARCHIVE_FILE
  108.     h   Prints this help message
  109.  
  110. =head1 SEE ALSO
  111.  
  112. tar(1), L<Archive::Tar>.
  113.  
  114. =cut
  115.